home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 23.zip / BS1 part 23 / Hisoft Basic v1.03 disk 2.adf / Video / Video.BAS < prev    next >
BASIC Source File  |  1988-12-03  |  6KB  |  271 lines
  1. ' HiSoft BASIC version:
  2. ' label Select has been changed to XSelect
  3. ' label Loop has been changed to XLoop
  4.  
  5. Setup:
  6.   Colors=4
  7.   d=15 : MaxColors=(2^Colors)-1 
  8.   TextColor=1
  9.   SCREEN CLOSE 2
  10.   IF Colors>2 THEN SCREEN 2,640,200,Colors,2 : WINDOW 2,"Videotitle",,28,2
  11.   DIM Text$(d),Colormatrix(d,3),Move(d),Speed(d)
  12.   Filler$=STRING$(16,"-")
  13.   Colormatrix(1,1)=15
  14.   Colormatrix(1,2)=15
  15.   Colormatrix(1,3)=15
  16.  
  17. Begin:
  18.   PRINT "Videotitle-Program ";
  19.   PRINT "by Hannes R"CHR$(252)"gheimer"
  20.   PRINT
  21.  
  22. XSelect:
  23.   PRINT "Select:"
  24.   PRINT "1  Enter Text"
  25.   PRINT "2  Read Object"
  26.   PRINT "3  Move Object"
  27.   PRINT "4  Define Color"
  28.   PRINT "5  Show Title"
  29.   PRINT
  30.  
  31. Query:
  32.   LOCATE 10,1
  33.   PRINT "Enter number:";
  34.   INPUT a$
  35.   a$=LEFT$(a$,1)
  36.   IF a$<"1" OR a$>"5" THEN BEEP: GOTO Query
  37.   IF a$="1" THEN EnterText
  38.   IF a$="2" THEN ReadObject
  39.   IF a$="3" THEN DefineMoveObject
  40.   IF a$="4" THEN DefineColor
  41.   IF a$="5" THEN ShowTitle
  42.   PRINT
  43.   END
  44.   
  45. EnterText:
  46.   CLS:INPUT "How many lines of text (1-15)";NoofLines$
  47.   IF NoofLines$="" THEN CLS: GOTO Begin
  48.   NoofLines=VAL(NoofLines$)
  49.   IF NoofLines<1 OR NoofLines>15 THEN BEEP: GOTO EnterText
  50.   FOR x=1 TO NoofLines
  51.     LINE INPUT "Text:";Text$(x)
  52.   NEXT x : CLS : GOTO Begin
  53.  
  54. ReadObject:
  55.   CLS
  56.   PRINT "Enter the NAME of the object you want TO load."
  57.   INPUT Objname$
  58.   IF Objname$="" THEN CLS : GOTO Begin
  59.   OPEN Objname$ FOR INPUT AS 1
  60.     OBJECT.SHAPE 1,INPUT$(LOF(1),1)
  61.   CLOSE 1
  62.   ObjFlag=1 : CLS : GOTO Begin
  63.  
  64. DefineMoveObject:
  65.   CLS:IF ObjFlag=0 THEN BEEP ELSE Mover
  66.   PRINT "No object currently in memory!"
  67.   PRINT "Press any key."
  68. Pause:
  69.   a$=INKEY$
  70.   IF a$="" THEN Pause
  71.   CLS: GOTO Begin
  72.  
  73. Mover:
  74.   PRINT "Move the object to it's starting point"
  75.   PRINT "using the cursor keys."
  76.   PRINT "When located press <RETURN>"
  77.   ox=100 : oy=100 : Destination=0
  78.   OBJECT.HIT 1,0,0
  79.   OBJECT.ON 1
  80.   OBJECT.STOP 1
  81. XLoop:
  82.   a$=INKEY$
  83.   IF a$=CHR$(13) THEN DestDef
  84.   IF a$=CHR$(28) THEN oy=oy-2
  85.   IF a$=CHR$(31) THEN ox=ox-5
  86.   IF a$=CHR$(30) THEN ox=ox+5
  87.   IF a$=CHR$(29) THEN oy=oy+2
  88.   OBJECT.X 1,ox : OBJECT.Y 1,oy
  89.   GOTO XLoop
  90.  
  91. DestDef:
  92.   CLS
  93.   Move(Destination*2+1)=ox : Move(Destination*2+2)=oy
  94.   Destination=Destination+1 : Move(0)=Destination
  95.   IF Destination=7 THEN Enddef
  96.   PRINT "Move the object to location"Destination
  97.   PRINT "<RETURN> = Set another location"
  98.   PRINT "<ESC> = End"
  99. Loop2:
  100.   a$=INKEY$
  101.   IF a$=CHR$(13) THEN DestDef
  102.   IF a$=CHR$(27) THEN Enddef
  103.   IF a$=CHR$(28) THEN oy=oy-2
  104.   IF a$=CHR$(31) THEN ox=ox-5
  105.   IF a$=CHR$(30) THEN ox=ox+5
  106.   IF a$=CHR$(29) THEN oy=oy+2
  107.   OBJECT.X 1,ox : OBJECT.Y 1,oy
  108.   GOTO Loop2
  109.  
  110. Enddef:
  111.   Move(0)=Destination
  112.   OBJECT.OFF 1
  113.   CLS : GOTO Begin
  114.  
  115. DefineColor:
  116.   CLS:PRINT "Color values:"
  117. Colors:
  118.   FOR x=0 TO MaxColors
  119.     COLOR -(x=0),x
  120.     LOCATE 5,(x*4) + 1
  121.     PRINT x;CHR$(32);CHR$(32)
  122.   NEXT x
  123.  
  124. ColorChange:
  125.   LOCATE 7,1:COLOR TextColor,Background
  126.   PRINT "Enter the number of the color you want to change."
  127.   PRINT "(e = End)"; : BEEP
  128.   INPUT Answer$
  129.   IF UCASE$(Answer$)="E" THEN AssignColor
  130.   Answer$=LEFT$(Answer$,2)
  131.   ColorNumber=VAL(Answer$)
  132.   IF ColorNumber<0 OR ColorNumber>MaxColors THEN BEEP: GOTO ColorChange
  133.  
  134. RGBRegulator:
  135.   r=Colormatrix(ColorNumber,1)
  136.   g=Colormatrix(ColorNumber,2)
  137.   b=Colormatrix(ColorNumber,3)
  138.   LOCATE 10,1: PRINT "Red:   <7>=- <8>=+ ";Filler$
  139.   LOCATE 10,20+r : PRINT CHR$(124);
  140.   LOCATE 11,1: PRINT "Green: <4>=- <5>=+ ";Filler$
  141.   LOCATE 11,20+g : PRINT CHR$(124);
  142.   LOCATE 12,1: PRINT "Blue:  <1>=- <2>=+ ";Filler$
  143.   LOCATE 12,20+b : PRINT CHR$(124);
  144.   LOCATE 13,1: PRINT "       <0>=Color o.k."
  145.   PALETTE ColorNumber,r/15,g/15,b/15
  146.  
  147. EnterKeys:
  148.   Key$=INKEY$
  149.   IF Key$="" THEN EnterKeys
  150.   IF Key$="7" THEN r=r-1
  151.   IF Key$="8" THEN r=r+1
  152.   IF Key$="4" THEN g=g-1
  153.   IF Key$="5" THEN g=g+1
  154.   IF Key$="1" THEN b=b-1
  155.   IF Key$="2" THEN b=b+1
  156.   IF Key$="0" THEN ColorChange
  157.   
  158.   IF r<0 THEN r=0
  159.   IF r>15 THEN r=15
  160.   IF g<0 THEN g=0
  161.   IF g>15 THEN g=15
  162.   IF b<0 THEN b=0
  163.   IF b>15 THEN b=15
  164.  
  165.   Colormatrix(ColorNumber,1)=r
  166.   Colormatrix(ColorNumber,2)=g
  167.   Colormatrix(ColorNumber,3)=b
  168.   GOTO RGBRegulator
  169.  
  170. AssignColor:
  171.   a=Background : a$="Background"
  172.   GOSUB EnterColor:Background=a
  173.   
  174.   a=TextColor : a$="Text Color"
  175.   GOSUB EnterColor:TextColor=a
  176.   
  177.   a=TextBackground : a$="Text Background"
  178.   GOSUB EnterColor:TextBackground=a
  179.   
  180.   COLOR TextColor,Background
  181.   CLS : GOTO Begin
  182.  
  183.  
  184. EnterColor:
  185.   LOCATE 14,1
  186.   PRINT a$": ";a
  187. Loop3:
  188.   LOCATE 14,1
  189.   PRINT a$; : INPUT Answer$
  190.   Answer=VAL(Answer$)
  191.   IF Answer$="" THEN Answer=.5
  192.   IF Answer<0 OR Answer>MaxColors THEN BEEP : GOTO Loop3
  193.   IF Answer<>.5 THEN a=Answer
  194.   RETURN
  195.  
  196.  
  197. ShowTitle:
  198.   CLS
  199.   PRINT "Press the <RETURN> key"
  200.   PRINT "to begin showing the title."
  201. WaitforKey:
  202.   a$=INKEY$
  203.   IF a$=CHR$(13) THEN CLS : c=10 :GOTO Countdown
  204.   GOTO WaitforKey
  205.  
  206. Countdown:
  207.   LOCATE 10,28 : PRINT c
  208.   c=c-1:IF c<0 THEN StartDisplay
  209.   Tim=INT(TIMER)
  210. Wait2:
  211.   IF INT(TIMER)=Tim THEN Wait2
  212.   GOTO Countdown
  213.  
  214. StartDisplay:
  215.   WIDTH 60 
  216.   COLOR TextColor,Background : CLS
  217.   COLOR TextColor,TextBackground
  218.   FOR x=1 TO NoofLines
  219.     Text$=LEFT$(Text$(x),60)
  220.     h=INT((60-LEN(Text$))/2)+2
  221.     LOCATE x+17-NoofLines,h : PRINT Text$
  222.   NEXT x
  223.   COLOR TextColor,Background
  224.   IF Move(0)=0 THEN MoveText
  225.      
  226.   OBJECT.X 1,Move(1)
  227.   OBJECT.Y 1,Move(2)
  228.   OBJECT.ON 1
  229.   FOR x=1 TO Move(0)-1
  230.     OBJECT.STOP 1
  231.     GOSUB VelocityCalc
  232.     OBJECT.X 1,Move(x*2-1)
  233.     OBJECT.Y 1,Move(x*2)
  234.     OBJECT.VX 1,Speed(x*2-1)
  235.     OBJECT.VY 1,Speed(x*2)
  236.     OBJECT.HIT 1,0,0
  237.     OBJECT.START 1
  238.     
  239.     Tst=TIMER
  240.  Loop4:
  241.     px=ABS(Move(x*2+1)-OBJECT.X(1))
  242.     py=ABS(Move(x*2+2)-OBJECT.Y(1))
  243.     IF INT(TIMER-Tst)<18 AND (px>15 OR py>15) THEN Loop4
  244.   NEXT x
  245.   OBJECT.OFF 1
  246.    
  247. MoveText:
  248.   Tst=TIMER
  249.   IF Move(0)<>0 THEN Finish
  250.   Wait3:
  251.     IF TIMER-Tst<(2*NoofLines+2) THEN Wait3
  252.   Finish:
  253.     FOR x=1 TO 30 
  254.       SCROLL (1,1)-(630,100),0,3
  255.       SCROLL (1,100)-(630,180),0,-3 
  256.     NEXT x
  257.     COLOR TextColor,Background
  258.   CLS : GOTO Begin
  259.  
  260. VelocityCalc:
  261.   ox=OBJECT.X (1) : oy=OBJECT.Y (1)
  262.   Move(x*2-1)=ox : Move(x*2)=oy
  263.   zx=Move(x*2+1) : zy=Move(x*2+2)
  264.     FOR xx=1 TO 64 STEP .2
  265.       Speed(x*2-1)=CINT((zx-ox)/xx)
  266.       Speed(x*2)=CINT((zy-oy)/xx)
  267.       IF ABS(Speed(x*2-1))<40 AND ABS(Speed(x*2))<40 THEN xx=64
  268.     NEXT xx
  269.   RETURN
  270.  
  271.